1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
|
SUBROUTINE PALICE(IZV,N,IVRSTA,IPALIC,IZMA,KON)
DIMENSION IZV(1),IPA(100)
IZMA=0
IMAK=0
KON=0
ISOTIC=0
DO 10 I=1,N
IF(IZV(I).GE.IMAK) THEN
IVMAK=I
IMAK=IZV(I)
ENDIF
ISOTIC=ISOTIC+IZV(I)
10 IPA(I)=IZV(I)
IF(IMAK.EQ.0) THEN
IZMA=1
KON=1
RETURN
ENDIF
IF(ISOTIC.EQ.0) KON=1
J=0
KODA=0
DO 20 I=1,N
20 IF(IZV(I).GE.2) J=J+1
IF(J.EQ.1) KODA=1
IF(J.EQ.0) KODA=2
LL=0
DO 21 L=1,N
IF(IPA(L).GT.0) LL=LL+1
21 CONTINUE
ICC=MOD(LL,2)
IF((KODA.EQ.1).AND.(IMAK.GT.1)) THEN
IF(ICC.EQ.0) THEN
IVRSTA=IVMAK
IPALIC=IMAK
IZMA=1
RETURN
ELSE
IVRSTA=IVMAK
IPALIC=IMAK-1
IZMA=1
RETURN
ENDIF
ENDIF
DO 30 I=1,N
IF(IPA(I).EQ.0) GO TO 30
DO 25 J=1,IMAK
IPA(I)=IPA(I)-J
IF(IPA(I).EQ.-1) THEN
IPA(I)=IPA(I)+J
GO TO 30
ENDIF
CALL SRC(IPA,N,IND)
IF((KODA.EQ.0).AND.(IND.EQ.0)) THEN
IVRSTA=I
IPALIC=J
IZMA=1
RETURN
ENDIF
25 IPA(I)=IPA(I)+J
30 CONTINUE
IF((KODA.EQ.2).AND.(ICC.EQ.0)) IZMA=1
C IVRSTA=IVMAK
C IPALIC=1
CALL GETTIM(LU,LM,LS,L)
IZN=1
J=MOD(L,N)+1
40 IF(IPA(J).EQ.0) J=J+IZN
IF(J.GT.N) THEN
IZN=-1
J=J-1
GO TO 40
ENDIF
IF(IPA(J).NE.0) GO TO 50
GO TO 40
50 IVRSTA=J
IPALIC=1
RETURN
END
|
